COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 trian3.lsp[f82,jmc]	How many queens will fit in a triangle
C00006 ENDMK
C⊗;
;;; trian3.lsp[f82,jmc]	How many queens will fit in a triangle
;;; multiple value bind version
(declare (special rank1 filenum t1 t2 w))

(defun solutions (ranklist filenum nqueens sols)
       (if (terp filenum)
	   (if (winp nqueens) (cons (outform ranklist nqueens) sols) sols)
	   (do ((m (moves ranklist filenum) (cdr m))
		(s1 sols 
		    (multiple-value-bind (ra fi nq)
					 (update (car m)
						 ranklist
						 filenum
						 nqueens)
					 (solutions ra fi nq s1))))
	       ((null m) s1))))

(defun moves (ranklist filenum)
       (cons 0 (do ((i 1 (1+ i))
		    (l nil (if (ok i ranklist)
			       (cons i l)
			       l)))
		   ((= i (1+ (- n filenum))) l))))

(defun ok (r list) (and (or (not (= r 1)) (not (< filenum rank1)))
			(ok1 r list 1)))

(defun ok1 (r list n)
       (or (null list)
	   (and (ok2 r (car list) n)
		(ok1 r (cdr list) (1+ n)))))

(defun ok2 (r r1 delta) (or (zerop r1) (not (or (= r r1)
						(= r (+ r1 delta))
						(= r (- r1 delta)) ))))

(defun terp (fi) (= n fi))

(defun winp (nq) (not (< nq nwin)))

(defun update (m ranklist filenum nqueens)
       (progn (if (null ranklist) (setq rank1 m))
	      (values (cons m ranklist)
		      (1+ filenum)
		      (if (= m 0) nqueens (1+ nqueens)))))

(defun outform (ranklist nqueens) (list (reverse ranklist) nqueens))

(setq rank1 0) ; used to avoid generating some symmetric solutions

(setq base (setq ibase 10.))

(defun test (m0 n0) (progn (setq n m0)
			   (setq nwin n0)
			   (setq t1 (runtime))
			   (setq w (solutions nil 0 0 nil))
			   (setq t2 (runtime))
			   (cons (- t2 t1) w)
))

;bfun
; (test 7 5) → .512 sec, (test 10 7) → 41.65 sec